TPUG - Toronto PET Users Group/TPUG Users Group CD/TPUG Users Group CD.iso/C64/A-Monthly Disks/(c)aae.d64/disk lab.msort

Commodore BASIC | 2007-02-04 | 4KB | 129 lines

0 CLR:X$="XX":FORI=.TO3:X$=X$+X$:NEXT
2 X$=X$+"XXXXXXX":GOTO12
4 REM**DISK LAB.MSORT BY FRED LAYBERGER
6 REM**OMAHA,NE - SEP 1985
8 POKE808,225:A1=PEEK(55):A2=PEEK(56):POKE55,PEEK(51):POKE56,PEEK(52):RETURN
10 Z=FRE(.):POKE55,A1:POKE56,A2:POKE808,237:RETURN
12 RESTORE:POKE53280,13:POKE53281,15:P$="[147]WORKING...[151]":PRINTP$
14 SD=8:DD=8:SR=0:DR=0:SA=4
16 IFPEEK(1015)<>.THENSD=PEEK(1015):DD=PEEK(1016):SR=PEEK(1017):DR=PEEK(1018):SA=PEEK(1019)
18 DL=830:IFPEEK(DL)=160THEN24
20 OPEN1,DD,.,MID$(STR$(DR),2,1)+":DISK LAB.DIR,S,R":FORI=DLTODL+148
22 INPUT#1,A:POKEI,A:NEXT:CLOSE1
24 CLOSE15:OPEN15,DD,15:GOSUB522
26 DIMV$(152):IFPEEK(49152)<>32THENLOAD"DISK LAB.SORT",DD,1:GOSUB522
28 OPEN1,DD,.,MID$(STR$(DR),2,1)+":\\MASTER*,S,R":GOSUB522
30 INPUT#1,N:INPUT#1,DT$:INPUT#1,ID$:INPUT#1,BK$:INPUT#1,P:NF=VAL(BK$):ND=N
32 D$=ID$:ID$="\\"
34 V$(.)=DT$+ID$+RIGHT$("    "+BK$,4):DIMT$(NF+1)
36 POKE850,76:POKE851,88:POKE852,3:POKE952,21
38 GOSUB8:FORI=1TON:SYSDL:V$(I)=LEFT$(X$,16)
40 PRINT""V$(I):NEXT:GOSUB10:CLOSE1
42 NF=1:IFP=2THENU=1:I=N+1:V$(I)=" \MSORTED*      ":GOTO48
44 GOTO150
46 FORI=1TOND:PRINTP$TAB(20)"DIRECTORY"I"[157] OF"ND
48 PRINT""V$(I)"[151]"TAB(20)"PROGRAM MAY PAUSE[151]"
50 CLOSE1:OPEN1,DD,DD,MID$(STR$(DR),2,1)+":"+V$(I)+",S,R":GOSUB522:IFP>1THENI=25
52 INPUT#1,N:INPUT#1,DT$:INPUT#1,ID$:INPUT#1,BK$:INPUT#1,P:GOSUB8
54 IFLEFT$(DT$,7)="\MASTER"THENID$="\\"
56 FORJ=1TON:SYSDL:IFP>1THENT$(NF)=LEFT$(X$,19):GOTO60
58 T$(NF)=LEFT$(X$,16)+RIGHT$("   "+STR$(I),3)
60 PRINT""LEFT$(T$(NF),16)TAB(20)"ITEM"NF"[157] OF "RIGHT$(V$(.),4)
62 IFP>1THENIFJ=ITHENGOSUB10:GOSUB8:I=I+25
64 NF=NF+1:IFNF>1200THENJ=N:I=ND
66 NEXT:GOSUB10:IFP>1THENCLOSE1:N=NF-1:GOTO104
68 NEXT:CLOSE1:N=NF-1:PRINTP$:Z=FRE(.)
100 PRINT"[147]  SORTING..."N"PROGRAMS"
102 SYS 49152,N,T$(1):P=2:POKE1015,SD:POKE1016,DD:POKE1017,SR:POKE1018,DR:POKE1019,SA
104 DT$=LEFT$(V$(.),16):ID$=MID$(V$(.),17,2):BK$=MID$(V$(.),19)
150 REM ** MAIN MENU
152 PRINT"[147]DONE -CHOOSE ONE[146][151]"
154 IFP<2THENPRINT" 1[146] ALPHABETIZE MASTER":IFNF=1THEN162
156 PRINT" 2[146] PRINT TO SCREEN"
158 PRINT" 3[146] PRINT TO PRINTER"
160 IFU<>1THENPRINT" 4[146] SAVE SORTED FILE"
162 PRINT" 5[146] RETURN TO DISK LABELER+"
164 PRINT" 6[146] QUIT"
166 GETA$:IFP<2THENIFA$="1"THEN46
168 IFNF=1THENIFP<2THEN176
170 IFA$="2"THENGOSUB502:GOTO150
172 IFA$="3"THENGOSUB402:GOTO150
174 IFU<>1THENIFA$="4"THENGOSUB302:GOTO150
176 IFA$="5"THEN202
178 IFA$<>"6"THEN166
180 END
200 REM ** RETURN TO LABELER
202 POKE1020,1:PRINT"[147]LOAD "CHR$(34)"DISK LABELER+*"CHR$(34)CHR$(44)DD
204 PRINT"RUN":POKE198,8:FORI=1TO7:POKE630+I,13:NEXT:PRINT"[151]":NEW
300 REM *** SAVE
302 PRINTP$:PRINT#15,"S"+MID$(STR$(DR),2,1)+":?\M*":F$=" \MSORTED       "
304 ID$=D$
306 OPEN1,DD,DD,MID$(STR$(DR),2,1)+":"+F$+",S,W":PRINT""F$"[151]"
308 PRINT#1,N:PRINT#1,DT$:PRINT#1,ID$:PRINT#1,BK$:PRINT#1,P:GOSUB8
310 FORI=1TON
312 IFU=1THENT$=V$(I)+"    ":GOTO316
314 T$=LEFT$(T$(I),16)+LEFT$(RIGHT$(T$(I),3)+"    ",4)
316 PRINT#1,T$:PRINT""LEFT$(T$,16);
318 PRINT" ITEM"I"[157] OF"N:NEXT:GOSUB10
320 CLOSE1:GOSUB522:IFU=1THENN=NF-1:ID$="\\":RETURN
322 F$="\\MASTER        ":N=ND
324 U=1:PRINTP$:GOTO306
400 REM ** PRINT TO PRINTER
402 PRINT"[147]  PREPARE PRINTER AND ALIGN PAPER [151]":GOSUB516:IFA$="^"THENRETURN
404 PRINT"  *** WORKING[151] *** DO NOT DISTRUB[146][151] ***"
406 E$=CHR$(27):S=4:CLOSES:OPENS,S,SA
408 DEFFNR(X)=INT((IP/CL-INT(IP/CL))*CL+.5):C1$=CHR$(15):C2$=CHR$(18):Z=.:IP=N
410 H1$=E$+"G"+E$+"E":H2$=E$+"H"+E$+"F"
412 A=2:E=17:B=8:C=1:D=1:CL=3:PL=56
414 T1$=C1$+E$+"G":T2$=C2$+E$+"H":PG=PL
416 P1$="":P9$="-----------------------------------"
418 PRINT#S,E$"U"CHR$(48);:FORI=1TOCL-1:PRINT#S,P1$SPC(B/A);:NEXT:PRINT#S,P1$
420 PRINT#S,H1$;:FORI=1TOC:PRINT#S:NEXT
422 PRINT#S:PRINT#S,SPC(E)CHR$(14)DT$ID$CHR$(20)
424 PRINT#S,SPC(E)MID$(STR$(VAL(BK$)),2)" BLOCKS FREE - "D$;:PRINT#S,H2$;
426 X=INT(IP/CL):IFN>PG*CLTHENX=PL:IP=PG*CL
428 C3=2*X:C4=3*X:C5=4*X:R=FNR(X):IFR>.THENIFR<=CLTHENX=X+1
430 C3=2*X:C4=3*X:C5=4*X
432 ONRGOTO436,438:REM **CL=3
434 GOTO440
436 C3=X:C4=2*X-1:GOTO440
438 C4=3*X-1:GOTO440
440 PRINT#S,T1$
442 FORI=1TOD:PRINT#S:NEXT:FORI=1TOCL-1:PRINT#S,P9$SPC(B);:NEXT:PRINT#S,P9$
444 IFZ>.THENC3=C3+Z:C4=C4+Z:C5=C5+Z:IFN<=PG*CLTHENIP=IP+Z
446 F=16:FORI=1TOX:GETA$:IFA$="^"THENI=X:GOTO500
448 PRINT#S,LEFT$(T$(I+Z),F)SPC(B-5);
450 K=VAL(RIGHT$(T$(I+Z),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
452 IFC3=>I+X+ZTHENPRINT#S,LEFT$(T$(I+X+Z),F)SPC(B-5);
454 IFC3=>I+X+ZTHENK=VAL(RIGHT$(T$(I+X+Z),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
456 IFI+C3>IPTHENPRINT#S:GOTO476
458 IFC4=>I+C3THENPRINT#S,LEFT$(T$(I+C3),F)SPC(B-5);
460 IFC4=>I+C3THENK=VAL(RIGHT$(T$(I+C3),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
462 IFI+C4>IPTHENPRINT#S:GOTO476
464 IFC5=>I+C4THENPRINT#S,LEFT$(T$(I+C4),F)SPC(B-5);
466 IFC5=>I+C4THENK=VAL(RIGHT$(T$(I+C4),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
468 IFI+C5>IPTHENPRINT#S:GOTO476
470 IFC5+X=>I+C5THENPRINT#S,LEFT$(T$(I+C5),F);
472 IFC5+X=>I+C5THENK=VAL(RIGHT$(T$(I+C5),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
474 PRINT#S
476 NEXT:IFX<PLTHENFORI=1TOINT(PL-X):PRINT#S:NEXT:IFXAND1THENPRINT#S
478 FORI=1TOCL:PRINT#S,P9$;SPC(B);:NEXT:PRINT#S:PRINT#S
480 IFN<=PG*CLTHEN500
482 PRINT#S,T2$:PRINT#S,H1$:FORI=1TOC:PRINT#S:NEXT
484 PRINT#S,CHR$(14)DT$ID$CHR$(20)" CONTINUED...":PRINT#S,"PAGE#"(PG/PL)+1" - "D$H2$
486 Z=PG*CL:IP=N-(PG*CL):PG=PG+PL:GOTO426
500 PRINT#S,T2$;:CLOSES:RETURN
502 REM *** PRINT TO SCREEN
504 PRINT"[147]  FILENAME"TAB(23)"DISKNAME[151]"
506 FORI=1TON
508 PRINTTAB(2)LEFT$(T$(I),16)TAB(23);
510 K=VAL(RIGHT$(T$(I),3)):PRINTLEFT$(V$(K),16)
512 IFPEEK(214)=23THENGOSUB516:PRINT"[147]":IFA$="^"THENI=N:NEXT:RETURN
514 NEXT
516 PRINT" PRESS A KEY TO CONTINUE - '^'TO RETURN[146][151]"
518 GETA$:IFA$=""THEN518
520 RETURN
522 INPUT#15,ER,ER$,T,S
524 IFERTHENPRINT" "ER;ER$;T;S:GOSUB516:END
526 RETURN